perm filename SC1X.OLD[SCR,LCS] blob sn#369208 filedate 1978-07-23 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C  THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C00013 ENDMK
C⊗;
C  THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C  AT STANFORD UNIVERSITY.  IT MAY NOT BE COPIED OR ALTERED IN ANY
C  WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.


C  7/74 **********  SCORE  **********  LELAND SMITH, SEP.1969

C   THIS PROGRAM WRITES NOTE LISTS FOR THE PDP10 SOUND 
C   GENERATION PROGRAM.
C   IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO'('HELP') FORMAT.
C   LOAD 'S1' WITH S2,S3,SCANR AND SPRINT 
C   (AND QUAD AND QUADO WHEN THEY ARE READY) AND
C   IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
C	SUBROUTINE SUBR
C	COMMON /P/P(1) /PL/PL(1) /INS/ INST(27),BG(60)
C	COMMON INUM,IPAR,CNT(27),BT,IREST,DF,DUR(27)
C   INUM=INST#  IPAR=PARAM#  
C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
C   INST=INST. NAME,  BG=INSTS' BEGIN TIMES.
C   NOTE #S IN SUBROUTINE: (1-84)  C4=37  FS4=43  C5=49  ETC.
C   F1=86  F15=100 (NO F16!)

	COMMON /Q/ BNW(200),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
	1 LN,ITYP,TPALN(4),JED /SAM/ISAM
CC 7/74 COLGATE  COMMON/TYP/ IS FOR COLTTY ROUT.
C  SEE LABEL 1774 AND BELOW RE. BUFFER LIMIT.
	COMMON/VV/LIMIT,V(5000) /A/ROFF(27),NP(27),
	1 RDEV(27),XT(27),OTH(20,16),SCAL(101)
	1 ,P1(27),JFM(4),IFM(80)
	1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
	DIMENSION LIST(78),JNP(80)
C   WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 
C   40 LIT CHARS + 99 PARAMS PER INST.
C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.

	COMMON /PCIP/ PCH(27,101),IPT(27,100)
	COMMON/P/P(99) /PL/PL(117) /COPY/NUMP,COPY(99)
C NUMP=99 = TOTAL NUMBER OF PARAMETERS NOW AVAILABLE. RAN.DEV. IS NUMP+1
	COMMON J,L,CNT(27),BT,MK,DF,DUR(27)
	1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
	1 ,INP(145),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
	COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
	1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
	1 ZZ,CHN,YY 
	1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
	1  /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
	1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
	1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
C  /C/=26
	EQUIVALENCE (LIST,IFM(3)),(JNP,INP)
	DATA KZY/27/,ISEMI/';'/,IQT/'"'/,LIMIT/5000/,NUMP/99/
	1, JFM(3)/','/
C  IAA=A  ID=D  IE=E  IF=F  IEN=N  IPP=P  ISS=S  ITT=T
	DATA IBLA/' '/,IXX/'X'/
	1 ,ISCA/'C','P','D','O','E','F','PLAY;','G','S','A','T','B'/
	1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
	TYPE 8003
8003	FORMAT(' FOR "MUS10" OUTPUT, FIRST TYPE "MUS10"'/)
C	1' NOW 99 PARAMETERS MAY BE USED.'/
C	1'     FOR RANDOM RESTS USE RR '/
C	1'         FOR RANDOM P1 DEVIATION USE RD'/)
	ISAM=-1
	LPAR=0
	IPRN=0
	QX=0.
	MOT=0
	RETRO=-1.
	INVRT=-1
	ICON=-1
	LCNT=1
	PARENS=0
      JZ=1  
	CALL RNDINT
C  INIT RAND NUM GENERATOR.
CC    PR=0  
	IAMP=0
C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
      T5=0  
      NINS=0
	K=0
	IDALL=-1
	QTS=-1.
      KB=0  
      NWZ=1
	BNW(1)=0
	I=1
      KL=0  
      TP=0  
      RA=0  
      CHN=0 
	DO 127 K=1,77,3
127	LIST(K)=0
C  INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
	NWX=0
	BY=-1
      DO 1128 K=1,KZY     
	INVIS(K)=0
	INST(K)=0
	CNT(K)=0
	RDEV(K)=0
C  RDEV IS FOR RAND DEVIATIONS AT RUN TIME
	NP(K)=0
	IQ(K)=0
C   IQ IS FOR RESTART FLAG
	IPT(K,1)=0
      DO 1128 L=1,NUMP+2
1128   PCH(K,L)=0 

	ITYP=-1
C   TYPE 'FILE NAME', TEMPO FACTOR(0=1), AMPL.FACT(0=1),
C   SECONDS TO BE OMITTED, DUR AT CUTOFF.
	JED=-1
2112	TYPE 8002
1112	ACCEPT 77732,JNP
	JFM(4)='5F)'
	JFM(1)='   (A'
C   FOR FREE 'A' FORMAT
	CALL FMT(JFM,JNP,MLX)
	REREAD JFM,K,TF,AMPFAC,OP1,DURX
C  JFM IS THE CURRENT FORMAT STATEMENT
	IF(K.NE.'MUS10')GO TO 999
	ISAM=0 
	TYPE 1999
	GO TO 2112
C SAMSWITCH ALLOWS FOR OVERLAPS OF INSTRUMENTS AND OMITS 'PLAY' AT TOP.
1999	FORMAT(' MUS10 SWITCH HAS BEEN SET.')
999	IF(K.NE.'EDIT')GO TO 3112
	JED=0
	GO TO 2112
C  'E(DIT)' GOES TO EDIT MODE
3112	IF(TF.EQ.0)TF=1.
	IF(AMPFAC.EQ.0)AMPFAC=1.
21122	IF(K.NE.'TYPE')GO TO 128
	ITYP=0
	DATA FINM/30H(' TYPE OUTPUT FILE NAME'/)   /
	IFLNM='TYPED'
CC	IFLNM='FOR21'
CC	REWIND 21
	CALL OFILE(21,IFLNM)
	GO TO 3127
8001	FORMAT(A5,5F)
77732	FORMAT(80A1)
300	FORMAT(I,3F)
128	IF(K.EQ.'INFO')GO TO 1280
	IF(K.EQ.'HELP')GO TO 1280
	IF(K.NE.'?')GO TO 3128
1280	TYPE 8002
	TYPE 1113
	TYPE 118
	TYPE 1114
	TYPE 8002
	GO TO 1112
118	FORMAT(' TO DSK=1,10   TTY=2,20   BOTH=0,30   LPT=22'/)
C118	FORMAT(' TO DSK=1, TTY=2, BOTH=0, LPT=22, PROOF=3, DEBUG=4'/)
CC***  TEMPORARY ***8002	FORMAT(' TYPE FILE NAME'/)
8002	FORMAT(' TYPE FILE NAME--  '$)
1113	FORMAT(' YOU MAY TYPE:  NAME  TEMPO-FAC  AMPFAC  OMIT"  DUR"'//)
1114	FORMAT(' YOU MAY TYPE UP TO 4 NUMBERS: N1 N2 N3 N4'//
	1' N1=1 WRITES DATA ON DSK,  =2 WRITES ONLY ON SCREEN,'/
	1'   =0 WRITES ON DSK AND SCREEN.'/
	1'   =10,20,30 ARE THE SAME AS 1,2,0 BUT INPUT LIST IS NOT'/
	1'   WRITTEN ON SCREEN.  (1 0 1,  2 0 1  OR 0 0 1 DO THE SAME.)'/
	1/' N2=RAN NUM,  N3=1=SUPPRESS INPUT LIST,  N4=DO SINGLE INST. #N'/
	1/' ALSO FOR N1:  N1=3=DURS ONLY (FOR PROOFING), =4=DEBUG V ARRAY'/
	1 3X' 27 INSTRUMENTS ARE AVAILABLE'/)

3128	IF(K.EQ.IBLA)K=IFLNM
	CALL IFILE(23,K)
	IFLNM=K
	READ(23,300)LN,IXIN
C  CHECK FOR LINE NUMBERS ONLY.
	REREAD 8001,K
	IF(K.NE.'COMME')GO TO 3000
3001	READ(23,77732)JNP
	IF(JNP(3).NE.ISEMI)GO TO 3001
	GO TO 3127
C  TO READ HEADER OF 'ET' FILES
3000	REWIND 23
	CALL IFILE(23,IFLNM)

CC3127	ISLAC=(IFLNM.AND."003777777777).OR."550000000000
C MAGIC TO CHANGE LFT. LETTER TO Z(INP. ABCDE BECOMES ZBCDE.DAT)
3127	ISLAC=IFLNM
C  NOW USES MY FORNAM SUBROUTINE TO  PUT EXTENSION .SCR ON OUTPUT
5127	TYPE 118
	IF(DURX.EQ.0)DURX=19999.
	IXIN=1
	INONLY=-1
	ACCEPT 300,MX,X,Y,Z
	IF(MX.NE.99)GO TO 6127
	TYPE FINM
	ACCEPT 8001,ISLAC
	GO TO 5127
6127	IF(Z.NE.0)INONLY=Z
	IF(MX.LT.10)GO TO 8127
CC	IF(MX.EQ.10)GO TO 7127
CC	IF(MX.EQ.20)GO TO 7127
	IF(MX.EQ.22)GO TO 8127
	IF(MX.EQ.30)MX=0
	MX=MX/10
	Y=1
C MX=10,11,ETC.,20,ETC.(INSTEAD OF 1,2) SUPPRESSES INPUT LISTING.
8127	IF(X.NE.0)IXIN=X
C   MX=3 GIVES DURS ONLY
C  TO SUPPRESS LIST OF INPUT DATA, TYPE ANY 3RD NUM. (BUT 9.)
C  (1 1 1 =RECORD,RAN. NUM=1,SUPPRESS INPUT.)
	MZ=0
	JOUT=5
C  5=OUTPUT TO TTY
	SOS=-1.
	IF(Y.NE.0)SOS=0  
C  IF 3RD NUM=0, EDIT FILE WILL PRINT AS IT IS READ.
	IF(MX.GT.4)MX=22
C ↑↑↑↑↑↑ TEMPORARY
	IF(MX.NE.22)GO TO 2107
CC	JOUT=3
C DIRECT TO LPT AT COLGATE 6/74
	JOUT=22
	REWIND 22
2107	IF(MX.GT.1)GO TO 277
	MX=MX-2
	CALL FORNAM(ISLAC,'SCR')
277	IF(MX.EQ.-2)GO TO 77
	IF(MX.EQ.2)GO TO 77
	IF(MX.NE.22)GO TO 177
77	MZ=-1
177	IF(MX.EQ.4)MZ=-4
      CALL READIT
      END